home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / mac / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Direct3D / PixelShader / frmPixelShader.frm next >
Text File  |  2001-10-08  |  21KB  |  693 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPixelShader 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "VB Pixel Shader"
  5.    ClientHeight    =   3195
  6.    ClientLeft      =   60
  7.    ClientTop       =   330
  8.    ClientWidth     =   4680
  9.    Icon            =   "frmPixelShader.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3195
  14.    ScaleWidth      =   4680
  15.    StartUpPosition =   3  'Windows Default
  16. End
  17. Attribute VB_Name = "frmPixelShader"
  18. Attribute VB_GlobalNameSpace = False
  19. Attribute VB_Creatable = False
  20. Attribute VB_PredeclaredId = True
  21. Attribute VB_Exposed = False
  22. Option Explicit
  23.  
  24. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  25. '
  26. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  27. '
  28. '  File:       FrmPixelShader.frm
  29. '  Content:    This sample shows how to use Pixel Shaders. It renders a few polys with
  30. '              different pixel shader functions to manipulate the way the textures look.
  31. '
  32. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  33.  
  34. ' This sample will use 7 different shaders.
  35. Private Const NUM_PIXELSHADERS = 7
  36.  
  37. ' A structure to describe the type of vertices the app will use.
  38. Private Type VERTEX2TC_
  39.     x As Single
  40.     y As Single
  41.     z As Single
  42.     rhw As Single
  43.     color0 As Long
  44.     color1 As Long
  45.     tu0 As Single
  46.     tv0 As Single
  47.     tu1 As Single
  48.     tv1 As Single
  49. End Type
  50. Dim VERTEX2TC(3) As VERTEX2TC_
  51. Dim verts(3) As VERTEX2TC_
  52.  
  53. ' Describe the vertex format that the vertices use.
  54. Private Const FVFVERTEX2TC = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX2)
  55.  
  56. ' Allocate a few DirectX object variables that the app needs to use.
  57. Dim dX As DirectX8
  58. Dim d3d As Direct3D8
  59. Dim dev As Direct3DDevice8
  60. Dim d3dx As D3DX8
  61. Dim d3dvb As Direct3DVertexBuffer8
  62. Dim d3dt(1) As Direct3DTexture8
  63.  
  64. 'Keep the present params around for resetting the device if needed
  65. Dim g_d3dpp As D3DPRESENT_PARAMETERS
  66.  
  67. ' This string array will store the shader functions
  68. Dim sPixelShader(6) As String
  69.  
  70. ' This array will store the pointers to the assembled pixel shaders
  71. Dim hPixelShader(6) As Long
  72.  
  73. Private Sub Form_Load()
  74.     
  75. '************************************************************************
  76. '
  77. ' Here the app will call functions to set up D3D, create a device,
  78. ' initialize the vertices, initialize the vertex buffers, create the
  79. ' textures, setup the shader string arrays, and assemble the pixel shaders.
  80. ' Finally, it calls Form_Paint to render everything.
  81. '
  82. '************************************************************************
  83.         
  84.     'Set the width and height of the window
  85.     Me.Width = 125 * Screen.TwipsPerPixelX
  86.     Me.Height = 225 * Screen.TwipsPerPixelY
  87.     Me.Show
  88.     DoEvents
  89.     
  90.     Call InitD3D
  91.     Call InitTextures
  92.     Call InitVerts
  93.     Call SetupShaders
  94.     Call InitDevice
  95.     Call PaintMe
  96.     'Call Form_Paint
  97.     
  98. End Sub
  99.  
  100. Private Sub InitVB()
  101.     
  102. '************************************************************************
  103. '
  104. ' This sub creates the vertex buffer that the app will use.
  105. '
  106. ' PARAMETERS:
  107. '           None.
  108. '************************************************************************
  109.                             
  110.     ' Create the vertex buffer, It will hold 4 vertices (two primitives).
  111.     Set d3dvb = dev.CreateVertexBuffer(4 * Len(VERTEX2TC(0)), D3DUSAGE_WRITEONLY, FVFVERTEX2TC, D3DPOOL_MANAGED)
  112.  
  113.     Call MoveVBVerts(0, 0)
  114.  
  115. End Sub
  116.  
  117. Private Sub MoveVBVerts(dX As Single, dY As Single)
  118.  
  119. '************************************************************************
  120. '
  121. ' This sub moves the vertices in the vertex buffer to a new location.
  122. '
  123. ' PARAMETERS:
  124. '           dx: A single that represents the new X coordinate for the upper left hand corner of the vertices.
  125. '           dy: A single that represents the new Y coordinate for the upper left hand corner of the vertices.
  126. '
  127. '************************************************************************
  128.     
  129.     Dim pVBVerts(3) As VERTEX2TC_
  130.     Dim pData As Long, i As Long, lSize As Long
  131.     
  132.     'Store the size of a vertex
  133.     lSize = Len(VERTEX2TC(0))
  134.     
  135.     'Lock and retrieve the data in the vertex buffer
  136.     Call D3DAUX.D3DVertexBuffer8GetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  137.     
  138.     For i = 0 To 3
  139.         'Set this vertex to equal the global vertex
  140.         pVBVerts(i) = verts(i)
  141.         'Add the X component to this vertex
  142.         pVBVerts(i).x = verts(i).x + dX
  143.         'Add the Y component to this vertex
  144.         pVBVerts(i).y = verts(i).y + dY
  145.     Next
  146.     
  147.     'Set and unlock the data in the vertex buffer.
  148.     Call D3DAUX.D3DVertexBuffer8SetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  149.     
  150. End Sub
  151.  
  152. Private Sub InitVerts()
  153.  
  154. '************************************************************************
  155. '
  156. ' This sub initializes the vertices
  157. '
  158. ' PARAMETERS:
  159. '           None.
  160. '
  161. '************************************************************************
  162.  
  163.     With verts(0)
  164.         .x = 10: .y = 10: .z = 0.5
  165.         .rhw = 1
  166.         .color0 = MakeRGB(&H0, &HFF, &HFF)
  167.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  168.         .tu0 = 0: .tv0 = 0
  169.         .tu1 = 0: .tv1 = 0
  170.     End With
  171.     
  172.     With verts(1)
  173.         .x = 40: .y = 10: .z = 0.5
  174.         .rhw = 1
  175.         .color0 = MakeRGB(&HFF, &HFF, &H0)
  176.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  177.         .tu0 = 1: .tv0 = 0
  178.         .tu1 = 1: .tv1 = 0
  179.     End With
  180.     
  181.     With verts(2)
  182.         .x = 40: .y = 40: .z = 0.5
  183.         .rhw = 1
  184.         .color0 = MakeRGB(&HFF, &H0, &H0)
  185.         .color1 = MakeRGB(&H0, &H0, &H0)
  186.         .tu0 = 1: .tv0 = 1
  187.         .tu1 = 1: .tv1 = 1
  188.     End With
  189.     
  190.     With verts(3)
  191.         .x = 10: .y = 40: .z = 0.5
  192.         .rhw = 1
  193.         .color0 = MakeRGB(&H0, &H0, &HFF)
  194.         .color1 = MakeRGB(&H0, &H0, &H0)
  195.         .tu0 = 0: .tv0 = 1
  196.         .tu1 = 0: .tv1 = 1
  197.     End With
  198.     
  199. End Sub
  200.  
  201. Private Sub InitTextures()
  202.         
  203. '************************************************************************
  204. '
  205. ' This sub initializes the textures that will be used.
  206. '
  207. ' PARAMETERS:
  208. '           None.
  209. '
  210. '************************************************************************
  211.  
  212.     Dim sFile As String
  213.     
  214.     sFile = FindMediaDir("lake.bmp") & "lake.bmp"
  215.     Set d3dt(1) = d3dx.CreateTextureFromFile(dev, sFile)
  216.     sFile = FindMediaDir("seafloor.bmp") & "seafloor.bmp"
  217.     Set d3dt(0) = d3dx.CreateTextureFromFile(dev, sFile)
  218.     
  219. End Sub
  220.  
  221. Private Sub SetupShaders()
  222.     
  223. '************************************************************************
  224. '
  225. ' This sub sets up the string arrays that contains each pixel shader.
  226. '
  227. ' PARAMETERS:
  228. '           None.
  229. '
  230. '************************************************************************
  231.  
  232.     ' 0: Display texture 0 (t0)
  233.     sPixelShader(0) = _
  234.     "ps.1.0 " & _
  235.     "tex t0 " & _
  236.     "mov r0,t0"
  237.     
  238.     ' 1: Display texture 1 (t1)
  239.     sPixelShader(1) = _
  240.     "ps.1.0 " & _
  241.     "tex t1 " & _
  242.     "mov r0,t1"
  243.     
  244.     ' 2: Blend between tex0 and tex1, using vertex 1 as the input (v1)
  245.     sPixelShader(2) = _
  246.     "ps.1.0 " & _
  247.     "tex t0 " & _
  248.     "tex t1 " & _
  249.     "mov r1,t1 " & _
  250.     "lrp r0,v1,r1,t0"
  251.  
  252.     ' 3: Scale texture 0 by vertex color 1 and add to texture 1
  253.     sPixelShader(3) = _
  254.     "ps.1.0 " & _
  255.     "tex t0 " & _
  256.     "tex t1 " & _
  257.     "mov r1,t0 " & _
  258.     "mad r0,t1,r1,v1"
  259.  
  260.     ' 4: Add all: texture 0, 1, and color 0, 1
  261.     sPixelShader(4) = _
  262.     "ps.1.0 " & _
  263.     "tex t0 " & _
  264.     "tex t1 " & _
  265.     "add r1,t0,v1 " & _
  266.     "add r1,r1,t1 " & _
  267.     "add r1,r1,v0 " & _
  268.     "mov r0,r1"
  269.     
  270.     ' 5: Modulate t0 by constant register c0
  271.     sPixelShader(5) = _
  272.     "ps.1.0 " & _
  273.     "tex t0 " & _
  274.     "mul r1,c0,t0 " & _
  275.     "mov r0,r1"
  276.     
  277.     ' 6: Lerp by t0 and t1 by constant register c1
  278.     sPixelShader(6) = _
  279.     "ps.1.0 " & _
  280.     "tex t0 " & _
  281.     "tex t1 " & _
  282.     "mov r1,t1 " & _
  283.     "lrp r0,c1,t0,r1"
  284.     
  285.         
  286. End Sub
  287.  
  288. Private Sub InitPixelShaders()
  289.  
  290. '************************************************************************
  291. '
  292. ' This sub creates the pixel shaders, and stores the pointer (handle) to them.
  293. '
  294. ' PARAMETERS:
  295. '           None.
  296. '
  297. '************************************************************************
  298.  
  299.     Dim pCode As D3DXBuffer
  300.     Dim i As Long, lArray() As Long, lSize As Long
  301.  
  302.     'Loop through each pixel shader string
  303.     For i = 0 To UBound(sPixelShader)
  304.         
  305.         'Assemble the pixel shader
  306.         Set pCode = d3dx.AssembleShader(sPixelShader(i), 0, Nothing)
  307.         
  308.         'Get the size of the assembled pixel shader
  309.         lSize = pCode.GetBufferSize() / 4
  310.         
  311.         'Resize the array
  312.         ReDim lArray(lSize - 1)
  313.         
  314.         'Retrieve the contents of the buffer
  315.         Call d3dx.BufferGetData(pCode, 0, 4, lSize, lArray(0))
  316.         
  317.         'Create the pixel shader.
  318.         hPixelShader(i) = dev.CreatePixelShader(lArray(0))
  319.         
  320.         Set pCode = Nothing
  321.         
  322.     Next
  323.  
  324. End Sub
  325.  
  326. Private Sub InitDevice()
  327.  
  328. '************************************************************************
  329. '
  330. ' This sub initializes the device to states that won't change, and sets
  331. ' the constant values that some of the pixel shaders use.
  332. '
  333. ' PARAMETERS:
  334. '           None.
  335. '
  336. '************************************************************************
  337.  
  338.     ' Constant registers store values that the pixel shaders can use. Each
  339.     ' constant is an array of 4 singles that contain information about color
  340.     ' and alpha components. This 2d array represents two pixel shader constants.
  341.     Dim fPSConst(3, 1) As Single
  342.     
  343.     'Used to set the constant values for c0 (used in pixel shader 5)
  344.     'Red
  345.     fPSConst(0, 0) = 0.15
  346.     'Green
  347.     fPSConst(1, 0) = 0.75
  348.     'Blue
  349.     fPSConst(2, 0) = 0.25
  350.     'Alpha
  351.     fPSConst(3, 0) = 0
  352.     
  353.     'Used to set the constant values for c1 (used in pixel shader 6)
  354.     'Red
  355.     fPSConst(0, 1) = 0.15
  356.     'Green
  357.     fPSConst(1, 1) = 1
  358.     'Blue
  359.     fPSConst(2, 1) = 0.5
  360.     'Alpha
  361.     fPSConst(3, 1) = 0
  362.  
  363.     'Create the vertex buffer
  364.     Call InitVB
  365.     
  366.     'Create the pixel shaders
  367.     Call InitPixelShaders
  368.  
  369.     With dev
  370.         
  371.         'Lighting isn't needed, since the vertices are prelit
  372.         Call .SetRenderState(D3DRS_LIGHTING, False)
  373.         
  374.         'Point the stream source to the vertex buffer that contains the vertices for rendering.
  375.         Call .SetStreamSource(0, d3dvb, Len(VERTEX2TC(0)))
  376.         
  377.         'Set the vertex shader to the flexible vertex format the app describes.
  378.         Call .SetVertexShader(FVFVERTEX2TC)
  379.         
  380.         'Set the pixel shader constans to the values that were set above.
  381.         Call .SetPixelShaderConstant(0, fPSConst(0, 0), 2)
  382.         
  383.     End With
  384.  
  385. End Sub
  386.  
  387. Private Sub PaintMe()
  388.     
  389. '************************************************************************
  390. '
  391. ' This sub is where all rendering happens. The vertices get moved to
  392. ' a new position, and then rendered.
  393. '
  394. ' PARAMETERS:
  395. '              None.
  396. '
  397. '************************************************************************
  398.             
  399.     Dim hr As Long
  400.     Static bNotReady As Boolean
  401.     
  402.     If Not dev Is Nothing And Me.ScaleHeight > 0 And Not d3dvb Is Nothing Then
  403.     
  404.         'Call TestCooperativeLevel to see what state the device is in.
  405.         hr = dev.TestCooperativeLevel
  406.         
  407.         If hr = D3DERR_DEVICELOST Then
  408.             
  409.             'If the device is lost, exit and wait for it to come back.
  410.             bNotReady = True
  411.             Exit Sub
  412.         
  413.         ElseIf hr = D3DERR_DEVICENOTRESET Then
  414.             
  415.             'The device is back, now it needs to be reset.
  416.             hr = 0
  417.             hr = ResetDevice
  418.             If hr Then Exit Sub
  419.             
  420.             bNotReady = False
  421.             
  422.         End If
  423.         
  424.         'Make sure the app is ready and that the form's height is greater than 0
  425.         If bNotReady Or Me.ScaleHeight < 1 Then Exit Sub
  426.                 
  427.         With dev
  428.                                     
  429.             Call .BeginScene
  430.             Call .Clear(0, ByVal 0, D3DCLEAR_TARGET, MakeRGB(0, 0, 255), 0, 0)
  431.  
  432.             'To just show the interpolation of each vertex color, remove all of the textures.
  433.             Call .SetTexture(0, Nothing)
  434.             Call .SetTexture(1, Nothing)
  435.             
  436.             'Move the vertices.
  437.             Call MoveVBVerts(0, 0)
  438.             'No pixel shader will be used for this one.
  439.             Call .SetPixelShader(0)
  440.             'Draw the two primitives.
  441.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  442.                                     
  443.             'Now set the two textures on the device.
  444.             Call .SetTexture(0, d3dt(0))
  445.             Call .SetTexture(1, d3dt(1))
  446.             
  447.             'Move the vertices
  448.             Call MoveVBVerts(50, 0)
  449.             'Use pixel shader 0
  450.             Call .SetPixelShader(hPixelShader(0))
  451.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  452.             
  453.             'The rest of the calls just move the vertices to a new position, set
  454.             'the next pixel shader, and render the two primitives.
  455.             Call MoveVBVerts(0, 50)
  456.             Call .SetPixelShader(hPixelShader(1))
  457.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  458.  
  459.             Call MoveVBVerts(50, 50)
  460.             Call .SetPixelShader(hPixelShader(2))
  461.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  462.         
  463.             Call MoveVBVerts(0, 100)
  464.             Call .SetPixelShader(hPixelShader(3))
  465.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  466.  
  467.             Call MoveVBVerts(50, 100)
  468.             Call .SetPixelShader(hPixelShader(4))
  469.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  470.  
  471.             Call MoveVBVerts(0, 150)
  472.             Call .SetPixelShader(hPixelShader(5))
  473.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  474.     
  475.             Call MoveVBVerts(50, 150)
  476.             Call .SetPixelShader(hPixelShader(6))
  477.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  478.     
  479.             Call .EndScene
  480.             Call .Present(ByVal 0, ByVal 0, 0, ByVal 0)
  481.         
  482.         End With
  483.         
  484.     End If
  485.  
  486.  
  487. End Sub
  488.  
  489. Private Function MakeRGB(r As Long, g As Long, b As Long) As Long
  490.  
  491. '************************************************************************
  492. '
  493. ' This function takes three longs and packs them into a single long to
  494. ' create an RGB color. Each parameter has to be in the range of 0-255.
  495. '
  496. ' PARAMETERS:
  497. '           r   Long that represents the red component
  498. '           g   Long that represents the green component
  499. '           b   Long that represents the blue component
  500. '
  501. ' RETURNS:
  502. '           A long that.
  503. '
  504. '************************************************************************
  505.  
  506.     MakeRGB = b
  507.     MakeRGB = MakeRGB Or (g * (2 ^ 8))
  508.     MakeRGB = MakeRGB Or (r * (2 ^ 16))
  509.  
  510. End Function
  511.  
  512. Private Sub InitD3D()
  513.     
  514. '************************************************************************
  515. '
  516. ' This sub initializes all the object variables, and creates the 3d device.
  517. '
  518. ' PARAMETERS:
  519. '            None.
  520. '
  521. '************************************************************************
  522.  
  523.     Dim d3ddm As D3DDISPLAYMODE
  524.     
  525.     'Turn off error handling, the app will handle any errors that occur.
  526.     On Local Error Resume Next
  527.         
  528.     'Get a new D3DX object
  529.     Set d3dx = New D3DX8
  530.     'Get a new DirectX object
  531.     Set dX = New DirectX8
  532.     'Create a Direct3D object
  533.     Set d3d = dX.Direct3DCreate()
  534.     
  535.     'Grab some information about the current display mode to see if the display
  536.     'was switched to something that isn't supported.
  537.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  538.     
  539.     'Make sure that the adapter is in a color bit depth greater than 8 bits per pixel.
  540.     If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  541.         
  542.         'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  543.         MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  544.         Unload Me
  545.         End
  546.         
  547.     End If
  548.     
  549.     With g_d3dpp
  550.         
  551.         'This app will run windowed.
  552.         .Windowed = 1
  553.         
  554.         'The backbuffer format is unknown. Since this is windowed mode,
  555.         'the app can just use whatever mode the device is in now.
  556.         .BackBufferFormat = d3ddm.Format
  557.         
  558.         'When running windowed, the information contained in the
  559.         'backbuffer is copied to the front buffer when Direct3DDevice.Present is called.
  560.         .SwapEffect = D3DSWAPEFFECT_COPY
  561.         
  562.     End With
  563.     
  564.     'Create the device using the default adapter on the system using software vertex processing.
  565.     Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, g_d3dpp)
  566.         
  567.     'Check to make sure the device was created successfully. If not, exit.
  568.     If dev Is Nothing Then
  569.         MsgBox "Unable to initialize Direct3D. App will now exit."
  570.         Unload Me
  571.         End
  572.     End If
  573.     
  574. End Sub
  575.  
  576. Private Sub Form_Paint()
  577.     
  578.     If d3dvb Is Nothing Then Exit Sub
  579.     
  580.     'Anytime the window receives a paint message, repaint the scene.
  581.     Call PaintMe
  582.     
  583. End Sub
  584.  
  585. Private Sub Form_Resize()
  586.     
  587.     If d3dvb Is Nothing Then Exit Sub
  588.     
  589.     'Anytime the form is resized, redraw the scene.
  590.     Call PaintMe
  591.     
  592. End Sub
  593.         
  594. Private Function ResetDevice() As Long
  595.  
  596. '***********************************************************************
  597. '
  598. ' This subroutine is called whenever the app needs to be resized, or the
  599. ' device has been lost.
  600. '
  601. ' Parameters:
  602. '
  603. '   None.
  604. '
  605. '***********************************************************************
  606.         
  607.     Dim d3ddm As D3DDISPLAYMODE
  608.     
  609.     On Local Error Resume Next
  610.     
  611.     'Call the sub that destroys the vertex buffer and shaders.
  612.     Call DestroyAll
  613.     
  614.     'Set the width and height of the window
  615.     Me.Width = 110 * Screen.TwipsPerPixelX
  616.     Me.Height = 225 * Screen.TwipsPerPixelY
  617.     
  618.      'Grab some information about the current adapters display mode.
  619.     'This may have changed since startup or the last D3DDevice8.Reset().
  620.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  621.         
  622.     'Refresh the backbuffer format using the retrieved format.
  623.      g_d3dpp.BackBufferFormat = d3ddm.Format
  624.     
  625.     'Now reset the device.
  626.     Call dev.Reset(g_d3dpp)
  627.     
  628.     'If something happens during the reset, trap any possible errors. This probably failed
  629.     'because the app doesn't have focus yet, but could fail is the user switched to an incompatible
  630.     'display mode.
  631.     
  632.     If Err.Number Then
  633.                 
  634.         'Make sure that the adapter is in a color bit-depth greater than 8 bits per pixel.
  635.         If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  636.             
  637.             'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  638.             MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  639.             Unload Me
  640.             End
  641.             
  642.         Else
  643.             
  644.             'More than likely the app just lost the display adapter. Keep spinning until the adapter becomes available.
  645.             ResetDevice = Err.Number
  646.             Exit Function
  647.             
  648.         End If
  649.     End If
  650.         
  651.     'Now get the device ready again
  652.     Call InitDevice
  653.     
  654.     'Redraw the scene
  655.     PaintMe
  656.     
  657. End Function
  658.  
  659. Private Sub Form_Unload(Cancel As Integer)
  660.  
  661.     ' When the app is exiting, call the DestroyAll() function to clean up.
  662.     Call DestroyAll
  663.     
  664. End Sub
  665.  
  666. Private Sub DestroyAll()
  667.  
  668. '***********************************************************************
  669. '
  670. ' This sub releases all the objects and pixel shader handles.
  671. '
  672. ' PARAMETERS:
  673. '           None.
  674. '
  675. '***********************************************************************
  676.     
  677.     Dim i As Long
  678.         
  679.     On Error Resume Next
  680.     
  681.     'Loop through and delete all pixel shaders.
  682.     For i = 0 To UBound(hPixelShader)
  683.         If hPixelShader(i) Then
  684.             Call dev.DeletePixelShader(hPixelShader(i))
  685.             hPixelShader(i) = 0
  686.         End If
  687.     Next
  688.     
  689.     'Destroy the vertex buffer if it exists.
  690.     If Not d3dvb Is Nothing Then Set d3dvb = Nothing
  691.     
  692. End Sub
  693.